home *** CD-ROM | disk | FTP | other *** search
/ HamCall (October 1991) / HamCall (Whitehall Publishing)(1991).bin / prgming / ada / sdepdg.ada < prev    next >
Text File  |  1987-10-19  |  5KB  |  170 lines
  1.  
  2. -- 
  3. -- I/O System Dependencies Package for MV 10000, ROLM Ada Development
  4. --   Environment, AOS Operating System
  5. -- 
  6. -- This visible section is derived from SYSDEP_SPEC.ADA by Stewart French, TI
  7. -- Derivation by Richard Conn, TI
  8. -- 
  9. package SYSDEP is
  10.  
  11. -- 
  12. -- Open the console for binary I/O, no echo
  13. -- 
  14.     procedure OPEN_CONSOLE;
  15.     pragma INLINE (OPEN_CONSOLE);
  16.  
  17. -- 
  18. -- Close the console, resetting parameters to their original condition
  19. -- 
  20.     procedure CLOSE_CONSOLE;
  21.     pragma INLINE (CLOSE_CONSOLE);
  22.  
  23. -- 
  24. -- Put a character to the terminal.  There should be no translation of the
  25. --   characters.  There may be exceptions to this rule (like CTRL-S and
  26. --   CTRL-Q for flow control), and these exceptions must be identified in
  27. --   IS_VALID_CHARACTER below.
  28. -- 
  29.     procedure PUT (CHAR : CHARACTER);
  30.     pragma INLINE (PUT);
  31.  
  32. -- 
  33. -- Get a character from the terminal keyboard with no echo and no
  34. --   translations.
  35. -- 
  36.     procedure GET (CHAR : out CHARACTER);
  37.     pragma INLINE (GET);
  38.  
  39. -- 
  40. -- Returns a boolean indicating whether the character is safe to use in the
  41. --   environment.  Suspicious characters may be CTRL-S, CTRL-Q, CTRL-C, CTRL-Y.
  42. -- 
  43.     function IS_VALID_CHARACTER (CHAR : CHARACTER) return BOOLEAN;
  44.     pragma INLINE (IS_VALID_CHARACTER);
  45.  
  46. end SYSDEP;
  47.  
  48.  
  49.  
  50.  
  51. with TTY_IO,
  52.      SYS_CALLS,
  53.      FILE_DEFINITIONS,
  54.      FILE_IO,
  55.      BIT_OPS;
  56. package body SYSDEP is
  57.  
  58.     BUFFER_BYTE_PTR     : INTEGER;
  59.     BUFFER              : INTEGER;
  60.  
  61.     INVALID_CHARS_ARRAY : array (1 .. 8) of CHARACTER;
  62.  
  63.     TERMINAL            : FILE_DEFINITIONS.CHANNEL_NUMBER;
  64.     TTY                 : TTY_IO.FILE_TYPE;
  65.  
  66. -- 
  67.     procedure OPEN_CONSOLE is
  68.  
  69.         CONSOLE_CHARACTERISTICS : FILE_IO.DEVICE_CHARACTERISTICS;
  70.         ERROR_CODE              : INTEGER;
  71.         AC0, AC1, AC2           : INTEGER;
  72.         NAME                    : SYS_CALLS.CALL_NAME;
  73.         ERROR_ID                : SYS_CALLS.ERROR_CODE;
  74.  
  75.     begin
  76.  
  77.         TTY_IO.OPEN (TTY, TTY_IO.INOUT_FILE, "@console");
  78.  
  79.         -- turn off the keyboard interrupt capabilities
  80.  
  81.         AC0 := 0;
  82.         AC1 := 0;
  83.         AC2 := 0;
  84.         NAME := SYS_CALLS.KIOFF;
  85.         SYS_CALLS.LONG_SYS (NAME, AC0, AC1, AC2, ERROR_ID);
  86.  
  87.         FILE_IO.OPEN
  88.            ("@console", TERMINAL, ERROR_CODE,
  89.             FILE_DEFINITIONS.OPEN_FOR_INPUT_OUTPUT +
  90.             FILE_DEFINITIONS.BINARY_IO + FILE_DEFINITIONS.VARIABLE_LENGTH);
  91.  
  92.         FILE_IO.GET_CHARACTERISTICS
  93.            (TERMINAL, CONSOLE_CHARACTERISTICS, ERROR_CODE);
  94.         CONSOLE_CHARACTERISTICS.ECHO := FILE_IO.NO_ECHO;
  95.         CONSOLE_CHARACTERISTICS.CHARACTERISTICS
  96.            (FILE_IO.NON_ANSI_STANDARD_DEVICE) := FALSE;
  97.         FILE_IO.SET_CHARACTERISTICS
  98.            (TERMINAL, CONSOLE_CHARACTERISTICS, ERROR_CODE);
  99.  
  100.         BUFFER_BYTE_PTR := INTEGER'VAL (BUFFER'ADDRESS);
  101.         BUFFER_BYTE_PTR := BIT_OPS.LEFT_SHIFT_BY_1 (BUFFER_BYTE_PTR);
  102.  
  103.     end OPEN_CONSOLE;
  104. --  pragma inline (OPEN_CONSOLE);
  105.  
  106. -- 
  107.     procedure CLOSE_CONSOLE is
  108.  
  109.         ERROR_CODE : INTEGER;
  110.  
  111.     begin
  112.         FILE_IO.CLOSE (TERMINAL, ERROR_CODE);
  113.     end CLOSE_CONSOLE;
  114. --  pragma inline (CLOSE_CONSOLE);
  115.  
  116.  
  117. -- 
  118.     procedure PUT (CHAR : CHARACTER) is
  119.  
  120.         DATA : STRING (1 .. 1);
  121.  
  122.     begin
  123.         DATA (1) := CHAR;
  124.         TTY_IO.PUT (TTY, DATA);
  125.     end PUT;
  126. --  pragma inline (PUT);
  127.  
  128. -- 
  129.     procedure GET (CHAR : out CHARACTER) is
  130.  
  131.         BYTES_READ : INTEGER;
  132.         ERROR_CODE : INTEGER;
  133.  
  134.     begin
  135.         FILE_IO.READ
  136.            (TERMINAL, ERROR_CODE, BYTES_READ, BUFFER_BYTE_PTR,
  137.             FILE_DEFINITIONS.BINARY_IO, 1);
  138.         BUFFER := BIT_OPS.LOGICAL_RIGHT_SHIFT (BUFFER, 24);
  139.         CHAR := CHARACTER'VAL (BUFFER);
  140.  
  141.     end GET;
  142. --  pragma inline (GET);
  143.  
  144.  
  145. -- 
  146.     function IS_VALID_CHARACTER (CHAR : CHARACTER) return BOOLEAN is
  147.  
  148.         VALID_FLAG : BOOLEAN;
  149.  
  150.     begin
  151.         VALID_FLAG := TRUE;
  152.         for I in 1 .. 8 loop
  153.             if INVALID_CHARS_ARRAY (I) = CHAR then
  154.                 VALID_FLAG := FALSE;
  155.             end if;
  156.         end loop;
  157.         return VALID_FLAG;
  158.     end IS_VALID_CHARACTER;
  159. --  pragma inline (IS_VALID_CHARACTER);
  160.  
  161. begin
  162.  
  163.     -- please refer to AOS/VS Programmer's Manual, Volume 1, System Concepts
  164.     -- page 5-20 for a description of these character codes.
  165.  
  166.     INVALID_CHARS_ARRAY (4) := ASCII.DC3; -- CTRL-S
  167.     INVALID_CHARS_ARRAY (5) := ASCII.DC1; -- CTRL-Q
  168.  
  169. end SYSDEP;
  170.